perm filename JUST.FAI[XAP,BGB] blob
sn#052884 filedate 1973-07-06 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TEXT JUSTFICATION MODES:
C00003 00003 SUBR TEXT
C00008 00004 SUBR SBLINE
C00011 ENDMK
C⊗;
;TEXT JUSTFICATION MODES:
$AUTOCR←←-1
$CLIP←← 0
$BOTH←← 1
$RIGHT←← 2
$CENTER←← 3
$LEFT←← 4
SUBR TEXT
BEGIN TEXT
LAC 1,CHAR
SKIPE TEXTPC
GO @TEXTPC ;Co-routine linkage!
GO NEWPAR
GETCHR: POP P,TEXTPC ;Where to continue co-routine
POP0J ;TEXT is called with a PUSHJ
;Begin a paragraph
NEWPAR: CALL LBFLUSH ;Flush any existing text
CR1:
NXTCHR: CALL GETCHR ;Get a character
GOTCHR: CAR 0,A00(1) ;Special?
JUMPN 0,SPCHAR
PUTCHR: SKIPN TJNODE ;If not clip mode
GO COLOK
LAC 0,COL ;Check column overflow
CAMGE 0,TJRMAR
GO COLOK ;OK
CALL LBLINE ;Put out line
SETOM LFFLAG ;Set flag for line feed
LAC 0,LMAR ;Reset margin and column
DAC 0,TJLMAR
DAC 0,COL
COLOK: LAC 2,FONT ;Check for font change
CAMN 2,TJFONT
GO FONTOK
LACI 2,177 ;Save number of font
IDBP 2,TJPTR
SOSG TJCNT
CALL LBLOSE
LAC 2,FONT
IDBP 2,TJPTR
SOSG TJCNT
CALL LBLOSE
SKIPN 2,FONTAB(2) ;Make sure the font exists!
CALL NOFONT
LAC 0,203(2) ;Check height
CAMLE 0,TJHEIGHT
DAC 0,TJHEIGHT
LAC 0,201(2) ;Check depth
SUB 0,203(2)
CAMLE 0,TJDEPTH
DAC 0,TJDEPTH
FONTOK: IDBP 1,TJPTR ;Put character into buffer
SOSG TJCNT
CALL LBLOSE
PUSH P,[NXTCHR] ;Fake a return address!
ADVCOL: LAC 2,FONT
SKIPN 2,FONTAB(2) ;Fetch address of font
CALL NOFONT ;Font not there!
ADD 2,1 ;Update column
CAR 0,(2)
ADDM 0,COL
POP0J
;Special characters
SPCHAR: CAIN 1," "
GO [ CALL PUTCHR ;Put space into line buffer
SKIPG TJMODE ;Are we justifying?
GO NXTCHR ;No, just get next character
CALL GETCHR ;Get another character
CAIN 1," " ;Flush multiple spaces (is this really
GO $.-2 ;a good idea?)
GO GOTCHR ] ;Put character into buffer
CAIN 1,15 ;<RETURN>?
GO [ SKIPG TJMODE ;Are we justifying?
GO [ CALL TJFLUSH ;No, flush current line
LAC 1,LMAR ;Reset column and left margin
DAC 1,TJLMAR
DAC 1,COL
GO NXTCHR ]
CALL GETCHR ;[Justify mode] Get another character
CAIE 1,12
GO [ FATAL(Bare <RETURN> illegal in justify mode) ]
CALL GETCHR ;Test for start of paragraph
CAR 0,A00(1) ;Special?
GO [ PUSH P,1 ;Save printing character
LACI 1," " ;Stuff space instead of return
CALL PUTCHR ;Put into buffer
POP P,1 ;Now do printer character
GO PUTCHR ]
CAIE 1,15
CAIN 1,12
GO [ CALL TJFLUSH
SETOM LFFLAG
CALL TJFLUSH
GO NEWPAR ]
CAIE 1,11
CAIN 1,40
GO [ CALL TJFLUSH
SETOM LFFLAG
CR2: CALL @0
CALL GETCHR
CAIE 1,11
CAIN 1,40
GO CR2
GO GOTCHR ]
CAIE 1,14
CAIN 1,13
GO [ CALL TJFLUSH
CALL @0
SETOM LFFLAG
GO NEWPAR ]
CALL @0
GO NXTCHR
GO PUTCHR ]
CAIN 1,12
GO [ SKIPG TJMODE
GO [ CALL TJFLUSH
SETOM LFFLAG
GO NXTCHR ]
FATAL(Bare <LINE FEED> illegal in text mode) ]
CAIE 1,13
CAIN 1,14
GO [ CALL TJFLUSH
CALL @0
SETOM LFFLAG
GO NEWPAR ]
CALL @0
GO NXTCHR
GO PUTCHR
BEND TEXT
SUBR SBLINE
PTR←←16
MOVE←←15
EXTRA←←14
PUSH P,1
PUSH P,EXTRA
PUSH P,PTR
PUSH P,MODE
PUSH P,CHAR
PUSH P,FONT
LAC MODE,TJMODE
LAC PTR,[POINT 7,LINBUF]
CAMN PTR,TJPTR
POP0J
LAC EXTRA,TJRMAR
SUB EXTRA,TJSPOS
LAC 1,TJLMAR
DAC 1,COL
LAC 1,TJPTR
CAILE MODE,$CLIP
DAC 1,TJSPTR
CAIN MODE,$CENTER
ASH EXTRA,-1
CAIE MODE,$RIGHT
CAIN MODE,$CENTER
ADDM EXTRA,COL
SKIPN LFFLAG
GO LOOP1
SETZM LFFLAG
LAC 1,TJDEPTH
CAMGE 1,TJODEPTH
LAC 1,TJODEPTH
ADD 1,TJHEIGTH
ADD 1,XLINE
ADDM 1,ROW
CALL ROWCHK
LOOP1: CAMN PTR,TJPTR
GO LINDON
ILDB 1,PTR
CAIN 1,177
GO [ ILDB 1,PTR
CAIN 1,177
GO .+1
DAC 1,FONT
GO LOOP1 ]
CAIN 1," "
CAIE MODE,$BOTH
GO [ DAC 1,CHAR
CALL PRINT
GO LOOP1]
LAC 0,EXTRA
IDIV 0,TJSCNT
SOSGE TJSCNT
GO [ FATAL(SPACE COUNT SCREWED UP) ]
SUB EXTRA,0
LAC 1,FONT
SKIPN 1,FONTAB(1)
CALL NOFONT
CAR 1," "(1)
ADD 1,0
ADDM 1,COL
GO LOOP1
LINDON: CAMN PTR,TJPTR
GO EMPTY
LAC PTR,[POINT 7,LINBUF,6]
LAC 1,FONT
IDPB 1,PTR
LACI 1,5*LILEN-2
DAC 1,TJCNT
LAC EXTRA,TJSPTR
LOOP2: CAMN EXTRA,TJPTR
GO MOVDON
ILDB 1,EXTRA
IDPB 1,PTR
SOS TJCNT
CAIE 1,177
GO LOOP2
CAMN EXTRA,TJPTR
HALT .
ILDB 1,EXTRA
IDPB 1,PTR
SOS TJCNT
CAIN 1,177
GO LOOP2
DAC 1,FONT
GO LOOP2
EMPTY:
MOVDON: SETZM TJSPTR
SETZM TJSCNT
SETZM TJSPOS
DAC PTR,TJPTR
REET: POP P,FONT
POP P,CHAR
POP P,MODE
POP P,PTR
POP P,EXTRA
POP P,1
POP0J